unit wgetgsp;

{****************************************************************************}

interface

uses Wincrt,Windos,
      CartoCmds,        (* Contient les def. globales *)
      tit_win,get_win,gmuf_win,aux_win,coul_win;


(*************************** gethff - 3 Nov 90 *****************************)

function get_gsp(var nomsc:string;var nlig_capt, ncol_capt, nbands, bit_count,
                  skiphead, skiprec, rowbytes, totalbytes, tabl_col:word;
                  var title:string;
                  var table_gsp:Pctable;
                  var pix_size,Long1,Lat1,long2,Lat2,long3,lat3,long4,lat4:real): integer;

{****************************************************************************}

implementation

(*************************** getbmp - 5 Juin 91 *****************************)

function get_gsp(var nomsc:string;var nlig_capt, ncol_capt, nbands, bit_count,
                  skiphead, skiprec, rowbytes, totalbytes, tabl_col:word;
                  var title:string;
                  var table_gsp:Pctable;
                  var pix_size,Long1,Lat1,long2,Lat2,long3,lat3,long4,lat4:real): integer;

const

(* FORMAT D'IMAGE  GSP *)

     card_capt = 8;

var   ier,i,j,l,k,n,nbcol,icol:integer;
      filename : string;
      f_rep,f_hdr,f_clr:text;
      rc : char;
      get_error : integer;
      il,val_min,val_sec,strwl : integer;
      xdim,ydim :real;
     _ligne:string;

label 997,998,999;

begin

  get_gsp := -1;

  Title := '';
  xdim := 0.0; ydim := 0.0;
  lat1 := 0.0; lat2 := 0.0; lat3 := 0.0; lat4 := 0.0;
  long1 := 0.0; long2 := 0.0; long3 := 0.0; long4 := 0.0;

{$I-}
  assign(f_rep,nomsc);
  reset(f_rep);
  if ioresult <> 0 then begin get_gsp := -2; goto 999; end;

    erreur := 0; get_error := -3;
    while (not(eof(f_rep))) or (erreur = 0) do begin
      erreur := read_ln(f_rep,S);
      if (copy(S,1,1) <> '#') and (copy(S,1,1) <> '!') then begin
        _nextpar(strw,S);

        if (copy(strw,1,length(strw)) = 'MAP_NAME') or
            (copy(strw,1,length(strw)) = 'map_name') then begin
            _nextpar(strw,S);
            Title := copy(strw,2,length(strw)-2);
        end;

        if (copy(strw,1,length(strw)) = 'LOCATION') or
            (copy(strw,1,length(strw)) = 'location') then begin
            _nextpar(strw,S);
            Title := Title+' - '+copy(strw,2,length(strw)-2);
        end;

        if (copy(strw,1,length(strw)) = 'NW_LON') or
            (copy(strw,1,length(strw)) = 'nw_lon') then begin
            _nextpar(strw,S); _nextpar(_ligne,S); strwl := length(strw);
            if (_ligne = 'DEG') or (_ligne = 'deg') then begin
              val(strw,long1,ier); if ier <> 0 then long1 := 0.0;
              long1 := long1*3600.0;
            end else begin
              val(copy(strw,strwl-1,2),val_sec,ier); if ier <> 0 then val_sec := 0;
              val(copy(strw,strwl-3,2),val_min,ier); if ier <> 0 then val_min := 0;
              val(copy(strw,1,strwl-4),il,ier); if ier <> 0 then il := 0;
              long1 := val_sec + val_min*60.0 + il*3600.0;
            end;
        end;

        if (copy(strw,1,length(strw)) = 'NE_LON') or
            (copy(strw,1,length(strw)) = 'ne_lon') then begin
            _nextpar(strw,S); _nextpar(_ligne,S); strwl := length(strw);
            if (_ligne = 'DEG') or (_ligne = 'deg') then begin
              val(strw,long2,ier); if ier <> 0 then long2 := 0.0;
              long2 := long2*3600.0;
            end else begin
              val(copy(strw,strwl-1,2),val_sec,ier); if ier <> 0 then val_sec := 0;
              val(copy(strw,strwl-3,2),val_min,ier); if ier <> 0 then val_min := 0;
              val(copy(strw,1,strwl-4),il,ier); if ier <> 0 then il := 0;
              long2 := val_sec + val_min*60.0 + il*3600.0;
            end;
        end;

        if (copy(strw,1,length(strw)) = 'SE_LON') or
            (copy(strw,1,length(strw)) = 'se_lon') then begin
            _nextpar(strw,S); _nextpar(_ligne,S); strwl := length(strw);
            if (_ligne = 'DEG') or (_ligne = 'deg') then begin
              val(strw,long3,ier); if ier <> 0 then long3 := 0.0;
              long3 := long3*3600.0;
            end else begin
              val(copy(strw,strwl-1,2),val_sec,ier); if ier <> 0 then val_sec := 0;
              val(copy(strw,strwl-3,2),val_min,ier); if ier <> 0 then val_min := 0;
              val(copy(strw,1,strwl-4),il,ier); if ier <> 0 then il := 0;
              long3 := val_sec + val_min*60.0 + il*3600.0;
            end;
        end;

        if (copy(strw,1,length(strw)) = 'SW_LON') or
            (copy(strw,1,length(strw)) = 'sw_lon') then begin
            _nextpar(strw,S); _nextpar(_ligne,S); strwl := length(strw);
            if (_ligne = 'DEG') or (_ligne = 'deg') then begin
              val(strw,long4,ier); if ier <> 0 then long4 := 0.0;
              long4 := long4*3600.0;
            end else begin
              val(copy(strw,strwl-1,2),val_sec,ier); if ier <> 0 then val_sec := 0;
              val(copy(strw,strwl-3,2),val_min,ier); if ier <> 0 then val_min := 0;
              val(copy(strw,1,strwl-4),il,ier); if ier <> 0 then il := 0;
              long4 := val_sec + val_min*60.0 + il*3600.0;
            end;
        end;

        if (copy(strw,1,length(strw)) = 'NW_LAT') or
            (copy(strw,1,length(strw)) = 'nw_lat') then begin
            _nextpar(strw,S); _nextpar(_ligne,S); strwl := length(strw);
            if (_ligne = 'DEG') or (_ligne = 'deg') then begin
              val(strw,lat1,ier); if ier <> 0 then lat1 := 0.0;
              lat1 := lat1*3600.0;
            end else begin
              val(copy(strw,strwl-1,2),val_sec,ier); if ier <> 0 then val_sec := 0;
              val(copy(strw,strwl-3,2),val_min,ier); if ier <> 0 then val_min := 0;
              val(copy(strw,1,strwl-4),il,ier); if ier <> 0 then il := 0;
              lat1 := val_sec + val_min*60.0 + il*3600.0;
            end;
        end;

        if (copy(strw,1,length(strw)) = 'NE_LAT') or
            (copy(strw,1,length(strw)) = 'ne_lat') then begin
            _nextpar(strw,S); _nextpar(_ligne,S); strwl := length(strw);
            if (_ligne = 'DEG') or (_ligne = 'deg') then begin
              val(strw,lat2,ier); if ier <> 0 then lat2 := 0.0;
              lat2 := lat2*3600.0;
            end else begin
              val(copy(strw,strwl-1,2),val_sec,ier); if ier <> 0 then val_sec := 0;
              val(copy(strw,strwl-3,2),val_min,ier); if ier <> 0 then val_min := 0;
              val(copy(strw,1,strwl-4),il,ier); if ier <> 0 then il := 0;
              lat2 := val_sec + val_min*60.0 + il*3600.0;
            end;
        end;

        if (copy(strw,1,length(strw)) = 'SE_LAT') or
            (copy(strw,1,length(strw)) = 'se_lat') then begin
            _nextpar(strw,S); _nextpar(_ligne,S); strwl := length(strw);
            if (_ligne = 'DEG') or (_ligne = 'deg') then begin
              val(strw,lat3,ier); if ier <> 0 then lat3 := 0.0;
              lat3 := lat3*3600.0;
            end else begin
              val(copy(strw,strwl-1,2),val_sec,ier); if ier <> 0 then val_sec := 0;
              val(copy(strw,strwl-3,2),val_min,ier); if ier <> 0 then val_min := 0;
              val(copy(strw,1,strwl-4),il,ier); if ier <> 0 then il := 0;
              lat3 := val_sec + val_min*60.0 + il*3600.0;
            end;
        end;

        if (copy(strw,1,length(strw)) = 'SW_LAT') or
            (copy(strw,1,length(strw)) = 'sw_lat') then begin
            _nextpar(strw,S); _nextpar(_ligne,S); strwl := length(strw);
            if (_ligne = 'DEG') or (_ligne = 'deg') then begin
              val(strw,lat4,ier); if ier <> 0 then lat4 := 0.0;
              lat4 := lat4*3600.0;
            end else begin
              val(copy(strw,strwl-1,2),val_sec,ier); if ier <> 0 then val_sec := 0;
              val(copy(strw,strwl-3,2),val_min,ier); if ier <> 0 then val_min := 0;
              val(copy(strw,1,strwl-4),il,ier); if ier <> 0 then il := 0;
              lat4 := val_sec + val_min*60.0 + il*3600.0;
            end;
        end;

        _nextpar(strw,S);
        if (copy(strw,length(strw)-3,4) = '.HDR') or
            (copy(strw,length(strw)-3,4) = '.hdr') then begin
            if get_error <> 0 then filename := strw;
            get_gsp := 0; get_error := 0;
        end;

      end;
    end;

    if get_error <> 0 then  goto 999;

998:
  close(f_rep);

  ier := getpath_File(nomsc,S);

  filename := S+filename;
  assign(f_hdr,filename);
  reset(f_hdr);
  if ioresult <> 0 then begin get_gsp := -4; goto 999; end;

  nlig_capt := 0;
  ncol_capt := 0;
  nbands := 0;
  bit_count := 0;

  skiphead := 0; skiprec := 0; rowbytes := 0; totalbytes := 0;

  erreur := 0;
  while (not(eof(f_hdr))) or (erreur = 0) do begin
    erreur := read_ln(f_hdr,S);
    if (copy(S,1,1) <> '#') and (copy(S,1,1) <> '!') then begin

(*
#      File Encoding
#                                                                             
  NCOLS                3090
  NROWS                3117
  NBANDS               1
#
  NBITS                8
BYTEORDER            M                                                        
SKIPBYTES            0                                                        
RECORDSKIPBYTES      0                                                        
BANDROWBYTES         3090                                                     
TOTALROWBYTES        3090                                                     
LAYOUT               BIL                                                      

*)
        _nextpar(strw,S);

        if (copy(strw,1,5) = 'NCOLS') or
            (copy(strw,1,5) = 'ncols') then begin
            _nextpar(strw,S); val(strw,ncol_capt, ier);
        end;

        if (copy(strw,1,length(strw)) = 'NROWS') or
            (copy(strw,1,length(strw)) = 'nrows') then begin
            _nextpar(strw,S); val(strw,nlig_capt, ier);
        end;

        if (copy(strw,1,length(strw)) = 'NBANDS') or
            (copy(strw,1,length(strw)) = 'nbands') then begin
            _nextpar(strw,S); val(strw,nbands, ier);
        end;

        if (copy(strw,1,length(strw)) = 'NBITS') or
            (copy(strw,1,length(strw)) = 'nbits') then begin
            _nextpar(strw,S); val(strw,bit_count, ier);
        end;

        if (copy(strw,1,length(strw)) = 'SKIPBYTES') or
            (copy(strw,1,length(strw)) = 'skipbytes') then begin
            _nextpar(strw,S); val(strw,skiphead, ier);
        end;

        if (copy(strw,1,length(strw)) = 'RECORDSKIPBYTES') or
            (copy(strw,1,length(strw)) = 'recordskipbytes') then begin
            _nextpar(strw,S); val(strw,skiprec, ier);
        end;

        if (copy(strw,1,length(strw)) = 'BANDROWBYTES') or
            (copy(strw,1,length(strw)) = 'bandrowbytes') then begin
            _nextpar(strw,S); val(strw,rowbytes, ier);
        end;

        if (copy(strw,1,length(strw)) = 'TOTALROWBYTES') or
            (copy(strw,1,length(strw)) = 'totalrowbytes') then begin
            _nextpar(strw,S); val(strw,totalbytes, ier);
        end;
(*
        if (copy(strw,1,length(strw)) = 'XDIM') or
            (copy(strw,1,length(strw)) = 'xdim') then begin
            _nextpar(strw,S); val(strw,xdim, ier);
        end;

        if (copy(strw,1,length(strw)) = 'YDIM') or
            (copy(strw,1,length(strw)) = 'Ydim') then begin
            _nextpar(strw,S); val(strw,xdim, ier);
        end;
*)
    end;
  end;

  close(f_hdr);

  if (nlig_capt = 0) or (ncol_capt = 0) or (nbands = 0) or (bit_count = 0)
    then begin get_gsp := -5; goto 999; end;

  pix_size := (xdim + ydim )*0.5;

  if rowbytes = 0 then rowbytes := ncol_capt;
  if totalbytes = 0 then
    totalbytes := skiphead + nbands*(skiprec+ncol_capt);
(*
  writeln(Title);
  writeln(nlig_capt,' ',ncol_capt,' ',nbands,' ',bit_count);
  writeln(skiphead,' ',skiprec,' ',rowbytes,' ',totalbytes);
*)

  tabl_col := 0;
  if bit_count <> 8 then goto 997;

  filename := copy(filename,1,length(filename)-4)+'.CLR';
  assign(f_clr,filename);
  reset(f_clr);
  ier := ioresult;
  if ier <> 0 then goto 997;

  erreur := 0; nbcol := 0;
  for i := 0 to 255 do begin
    table_gsp^[1,i] := 0; table_gsp^[2,i] := 0; table_gsp^[3,i] := 0;
  end;
  while (not(eof(f_clr))) or (erreur = 0) do begin
    erreur := read_ln(f_clr,S);
    if (copy(S,1,1) <> '#') and (copy(S,1,1) <> '!')
      and (S <> '') then begin
      nbcol := nbcol + 1;
      _nextpar(strw,S); val(strw,icol, ier);
      if nbcol <= 256 then begin
        if (icol >= 0) and (icol<=255) then begin
          _nextpar(strw,S); val(strw,table_gsp^[1,icol], ier);
          _nextpar(strw,S); val(strw,table_gsp^[2,icol], ier);
          _nextpar(strw,S); val(strw,table_gsp^[3,icol], ier);
        end;
      end;
    end;
  end;
  tabl_col := 1;

  close(f_clr);
{$I+}

997:
  nomsc := copy(FileName,1,length(Filename)-4);
  get_gsp := 0;

999:end;

end.

